home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 001_100 / disk0090 / creatper.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1989-01-30  |  2.8 KB  |  87 lines
  1. 100  REM CREATPER Program
  2. 110  REM Creates (Formats) a Persons File
  3. 120  REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
  4. 130  OPTION BASE 0
  5. 140  DEFINT A-Z
  6. 600  REM Titles
  7. 610  TITLE$ = "Create a Persons File"
  8. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  9. 700  REM Terminate if not called from the Menu
  10. 710  IF COPY2$ = "Melvin O. Duke" THEN 770
  11. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  12. 730  PRINT "Cannot run the"
  13. 740  PRINT TITLE$
  14. 750  PRINT "Program, unless selected from the MENU"
  15. 760  END
  16. 770  REM OK
  17. 1000  REM Produce the first screen
  18. 1010  KEY ON : CLS : KEY OFF
  19. 1040  REM Find the title location
  20. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  21. 1080  REM Print the title
  22. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  23. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  24. 1250  REM Print the Copyright
  25. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  26. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  27. 1700  REM Display the Copyright
  28. 1710  '
  29. 1720  LOCATE 25,1
  30. 1730  PRINT DATADISK$;
  31. 1740  K$ = INKEY$ : IF K$ = "" THEN 1740
  32. 1750  KEY ON : CLS : KEY OFF
  33. 1760  REM Give the User one more chance to protect himself.
  34. 1770  LOCATE 10,1
  35. 1780  PRINT "This program FORMATS a Persons-file by writing new, empty records."
  36. 1790  PRINT "It will destroy any data which exists with the same record-numbers."
  37. 1800  PRINT
  38. 1810  PRINT "If this is REALLY what you want to do,"
  39. 1820  PRINT "type  y  to continue, and press the 'enter' key."
  40. 1830  PRINT "Otherwise, type anything else, and press the 'enter' key."
  41. 1840  PRINT
  42. 1850  LINE INPUT "Enter your desired action: ",REPLY$
  43. 1860  IF LEFT$(REPLY$,1) = "y" THEN 2000
  44. 1870  IF LEFT$(REPLY$,1) = "Y" THEN 2000
  45. 1880  PRINT
  46. 1890  PRINT "File was NOT Created."
  47. 1900  PRINT
  48. 1910  PRINT "Press any key to continue"
  49. 1920  A$ = INKEY$ : IF A$ = "" THEN 1920
  50. 1930  GOTO 2330  'to end the program
  51. 2000  REM CREATPER Program Starts Here
  52. 2010  OPEN CC.PERSFILE$ AS #1 LEN = 256
  53. 2020  FIELD 1,5ASF1$,20ASF2$,30ASF3$,2ASF4$,5ASF5$,5ASF6$,5ASF7$,11ASF8$,18ASF9$,16ASF10$,16ASF11$,11ASF12$,18ASF13$,16ASF14$,16ASF15$,11ASF16$,18ASF17$,16ASF18$,16ASF19$
  54. 2030  REM Write the Persons Records
  55. 2040  FOR I = OLD.MAX.PER + 1 TO MAX.PER
  56. 2050   TEMP! = -I
  57. 2060   TEMP$ = MKS$(TEMP!)
  58. 2070   LSET F1$ = TEMP$          'Record Number
  59. 2080   TEMP$ = " "
  60. 2090   TEMP! = 0
  61. 2100   LSET F2$ = TEMP$          'Surname
  62. 2110   LSET F3$ = TEMP$          'Given Names
  63. 2120   LSET F4$ = TEMP$          'Sex
  64. 2130   LSET F5$ = MKS$(TEMP!)    'Code
  65. 2140   LSET F6$ = MKS$(TEMP!)    'Father
  66. 2150   LSET F7$ = MKS$(TEMP!)    'Mother
  67. 2160   REM all the rest are string
  68. 2170   LSET F8$ = TEMP$          'Birth Date
  69. 2180   LSET F9$ = TEMP$          'Birth City
  70. 2190   LSET F10$ = TEMP$         'Birth County
  71. 2200   LSET F11$ = TEMP$         'Birth State
  72. 2210   LSET F12$ = TEMP$         'Death Date
  73. 2220   LSET F13$ = TEMP$         'Death City
  74. 2230   LSET F14$ = TEMP$         'Death County
  75. 2240   LSET F15$ = TEMP$         'Death State
  76. 2250   LSET F16$ = TEMP$         'Burial Date
  77. 2260   LSET F17$ = TEMP$         'Burial City
  78. 2270   LSET F18$ = TEMP$         'Burial County
  79. 2280   LSET F19$ = TEMP$         'Burial State
  80. 2290   LOCATE 23,1 : PRINT "Writing Record Number:";I
  81. 2300   PUT #1,I
  82. 2310  NEXT I
  83. 2320  CLOSE #1
  84. 2330  KEY ON : CLS : KEY OFF : LOCATE 21,1
  85. 2340  PRINT "End of Program"
  86. 2350  RUN CC.MENU$
  87.